home *** CD-ROM | disk | FTP | other *** search
/ Wayzata's Best of Shareware PC/Windows 2 / Wayzata's Best of Shareware 2.0 (Windows) (Wayzata Technology)(7112)(1994).bin / pc / dos / programg / bwb110 / bwb_var.c < prev    next >
C/C++ Source or Header  |  1992-10-27  |  58KB  |  2,207 lines
  1. /***************************************************************
  2.  
  3.         bwb_var.c       Variable-Handling Routines
  4.                         for Bywater BASIC Interpreter
  5.  
  6.                         Commands:    DIM
  7.                                         COMMON
  8.                                         ERASE
  9.                                         SWAP
  10.                     CLEAR
  11.  
  12.                         Copyright (c) 1992, Ted A. Campbell
  13.  
  14.                         Bywater Software
  15.                         P. O. Box 4023
  16.                         Duke Station
  17.                         Durham, NC  27706
  18.  
  19.                         email: tcamp@acpub.duke.edu
  20.  
  21.         Copyright and Permissions Information:
  22.  
  23.         All U.S. and international copyrights are claimed by the
  24.         author. The author grants permission to use this code
  25.         and software based on it under the following conditions:
  26.         (a) in general, the code and software based upon it may be
  27.         used by individuals and by non-profit organizations; (b) it
  28.         may also be utilized by governmental agencies in any country,
  29.         with the exception of military agencies; (c) the code and/or
  30.         software based upon it may not be sold for a profit without
  31.         an explicit and specific permission from the author, except
  32.         that a minimal fee may be charged for media on which it is
  33.         copied, and for copying and handling; (d) the code must be
  34.         distributed in the form in which it has been released by the
  35.         author; and (e) the code and software based upon it may not
  36.         be used for illegal activities.
  37.  
  38. ***************************************************************/
  39.  
  40. #include <stdio.h>
  41. #include <stdlib.h>
  42. #include <ctype.h>
  43. #include <math.h>
  44. #include <string.h>
  45.  
  46. #include "bwbasic.h"
  47. #include "bwb_mes.h"
  48.  
  49. struct bwb_variable var_start, var_end;
  50.  
  51. int dim_base = 0;                            /* set by OPTION BASE */
  52. static int dimmed = FALSE;                      /* has DIM been called? */
  53. static int first, last;                /* first, last for DEFxxx commands */
  54.  
  55. /* Prototypes for functions visible to this file only */
  56.  
  57. static int dim_check( struct bwb_variable *v, int *pp );
  58. static int var_defx( struct bwb_line *l, int type );
  59. static int var_letseq( char *buffer, int *position, int *start, int *end );
  60. static size_t dim_unit( struct bwb_variable *v, int *pp );
  61.  
  62. /***************************************************************
  63.  
  64.         FUNCTION:       var_init()
  65.  
  66.         DESCRIPTION:    This function initializes the internal 
  67.         linked list of variables.
  68.  
  69. ***************************************************************/
  70.  
  71. int
  72. var_init()
  73.    {
  74.    var_start.next = &var_end;
  75.    strcpy( var_start.name, "<START>" );
  76.    strcpy( var_end.name, "<END>" );
  77.    return TRUE;
  78.    }
  79.  
  80. /***************************************************************
  81.  
  82.         FUNCTION:       bwb_common()
  83.  
  84.         DESCRIPTION:    This C function implements the BASIC
  85.                 COMMON command.
  86.  
  87. ***************************************************************/
  88.  
  89. struct bwb_line *
  90. bwb_common( struct bwb_line *l )
  91.    {   
  92.    register int loop;
  93.    struct bwb_variable *v;
  94.    char tbuf[ MAXSTRINGSIZE + 1 ];
  95.  
  96.    /* loop while arguments are available */
  97.  
  98.    loop = TRUE;
  99.    while ( loop == TRUE )
  100.       {
  101.  
  102.       /* get variable name and find variable */
  103.  
  104.       bwb_getvarname( l->buffer, tbuf, &( l->position ) );
  105.  
  106.       if ( ( v = var_find( tbuf ) ) == NULL )
  107.          {
  108.          bwb_error( err_syntax );
  109.          return l;
  110.          }
  111.  
  112.       v->common = TRUE;                /* set common flag to true */
  113.  
  114.       /* check for comma */
  115.  
  116.       adv_ws( l->buffer, &( l->position ) );
  117.       if ( l->buffer[ l->position ] != ',' )
  118.          {
  119.          return l;                /* no comma; leave */
  120.          }
  121.       ++( l->position );
  122.       adv_ws( l->buffer, &( l->position ) );
  123.  
  124.       }
  125.  
  126.    }
  127.  
  128. /***********************************************************
  129.  
  130.         Function:    bwb_ddbl()
  131.  
  132.         This function implements the BASIC DEFDBL command.
  133.  
  134. ***********************************************************/
  135.  
  136. struct bwb_line *
  137. bwb_ddbl( struct bwb_line *l )
  138.    {
  139.  
  140.    /* call generalized DEF handler with DOUBLE set */
  141.  
  142.    var_defx( l, DOUBLE );
  143.    
  144.    return l;
  145.  
  146.    }
  147.  
  148. /***********************************************************
  149.  
  150.         Function:    bwb_dint()
  151.  
  152.         This function implements the BASIC DEFINT command.
  153.  
  154. ***********************************************************/
  155.  
  156. struct bwb_line *
  157. bwb_dint( struct bwb_line *l )
  158.    {
  159.  
  160.    /* call generalized DEF handler with INTEGER set */
  161.  
  162.    var_defx( l, INTEGER );
  163.    
  164.    return l;
  165.  
  166.    }
  167.  
  168. /***********************************************************
  169.  
  170.         Function:    bwb_dsng()
  171.  
  172.         This function implements the BASIC DEFSNG command.
  173.  
  174. ***********************************************************/
  175.  
  176. struct bwb_line *
  177. bwb_dsng( struct bwb_line *l )
  178.    {
  179.  
  180.    /* call generalized DEF handler with SINGLE set */
  181.  
  182.    var_defx( l, SINGLE );
  183.    
  184.    return l;
  185.  
  186.    }
  187.  
  188. /***********************************************************
  189.  
  190.         Function:    bwb_dstr()
  191.  
  192.         This function implements the BASIC DEFSTR command.
  193.  
  194. ***********************************************************/
  195.  
  196. struct bwb_line *
  197. bwb_dstr( struct bwb_line *l )
  198.    {
  199.  
  200.    /* call generalized DEF handler with STRING set */
  201.  
  202.    var_defx( l, STRING );
  203.    
  204.    return l;
  205.  
  206.    }
  207.  
  208. /***********************************************************
  209.  
  210.         Function:    var_defx()
  211.  
  212.         This function is a generalized DEFxxx handler.
  213.  
  214. ***********************************************************/
  215.  
  216. static int
  217. var_defx( struct bwb_line *l, int type )
  218.    {
  219.    int loop;
  220.    register int c;
  221.    static char vname[ 2 ];
  222.    struct bwb_variable *v;
  223.  
  224.    /* loop while there are variable names to process */
  225.  
  226.    loop = TRUE;
  227.    while ( loop == TRUE )
  228.       {
  229.  
  230.       /* check for end of line or line segment */
  231.  
  232.       adv_ws( l->buffer, &( l->position ) );
  233.       switch( l->buffer[ l->position ] )
  234.          {
  235.          case '\n':
  236.          case '\r':
  237.          case '\0':
  238.          case ':':
  239.             return FALSE;
  240.          }
  241.  
  242.       /* find a sequence of letters for variables */
  243.  
  244.       if ( var_letseq( l->buffer, &( l->position ), &first, &last ) == FALSE )
  245.          {
  246.          return FALSE;
  247.          }
  248.       
  249.       /* loop through the list getting variables */
  250.  
  251.       for ( c = first; c <= last; ++c )
  252.          {
  253.          vname[ 0 ] = (char) c;
  254.          vname[ 1 ] = '\0';
  255.          
  256.          #if INTENSIVE_DEBUG
  257.          sprintf( bwb_ebuf, "in var_defx(): calling var_find() for <%s>",
  258.             vname );
  259.          bwb_debug( bwb_ebuf );
  260.          #endif
  261.  
  262.          v = var_find( vname );
  263.  
  264.          /* but var_find() assigns on the basis of name endings
  265.             (so all in this case should be SINGLEs), so we must
  266.             force the type of the variable */
  267.  
  268.          var_make( v, type );
  269.  
  270.          }
  271.  
  272.       }
  273.    
  274.    return TRUE;
  275.  
  276.    }
  277.  
  278. /***********************************************************
  279.  
  280.         Function:    var_letseq()
  281.  
  282.         This function finds a sequence of letters for a DEFxxx
  283.         command.
  284.  
  285. ***********************************************************/
  286.  
  287. static int
  288. var_letseq( char *buffer, int *position, int *start, int *end )
  289.    {
  290.  
  291.    #if INTENSIVE_DEBUG
  292.    sprintf( bwb_ebuf, "in var_letseq(): buffer <%s>", &( buffer[ *position ] ));
  293.    bwb_debug( bwb_ebuf );
  294.    #endif
  295.  
  296.    /* advance beyond whitespace */
  297.  
  298.    adv_ws( buffer, position );
  299.  
  300.    /* check for end of line */
  301.  
  302.    switch( buffer[ *position ] )
  303.       {
  304.       case '\0':
  305.       case '\n':
  306.       case '\r':
  307.       case ':':
  308.          return TRUE;
  309.       }
  310.  
  311.    /* character at this position must be a letter */
  312.  
  313.    if ( isalpha( buffer[ *position ] ) == 0 )
  314.       {      
  315.       bwb_error( err_defchar );
  316.       return FALSE;
  317.       }
  318.  
  319.    *end = *start = buffer[ *position ];
  320.       
  321.    /* advance beyond character and whitespace */
  322.  
  323.    ++( *position );
  324.    adv_ws( buffer, position );
  325.  
  326.    /* check for hyphen, indicating sequence of more than one letter */
  327.  
  328.    if ( buffer[ *position ] == '-' )
  329.       {
  330.  
  331.       ++( *position );
  332.       
  333.       /* advance beyond whitespace */
  334.  
  335.       adv_ws( buffer, position );
  336.  
  337.       /* character at this position must be a letter */
  338.  
  339.       if ( isalpha( buffer[ *position ] ) == 0 )
  340.          {
  341.          *end = *start;
  342.          }
  343.       else
  344.          {
  345.          *end = buffer[ *position ];
  346.          ++( *position );
  347.          }
  348.       
  349.       }
  350.  
  351.    /* advance beyond comma if present */
  352.  
  353.    if ( buffer[ *position ] == ',' )
  354.       {
  355.       ++( *position );
  356.       }
  357.  
  358.    return TRUE;
  359.    }
  360.  
  361. /***********************************************************
  362.  
  363.         Function:    bwb_clear()
  364.  
  365.         This function implements the BASIC CLEAR command.
  366.  
  367. ***********************************************************/
  368.  
  369. struct bwb_line *
  370. bwb_clear( struct bwb_line *l )
  371.    {
  372.    struct bwb_variable *v;
  373.    register int n;
  374.    int *ip;
  375.    bstring *sp;
  376.    float *fp;
  377.    double *dp;
  378.    
  379.    for ( v = var_start.next; v != &var_end; v = v->next )
  380.       {
  381.       switch( v->type )
  382.          {
  383.          case SINGLE:
  384.             fp = (float *) v->array;
  385.             for ( n = 0; n < v->array_units; ++n )
  386.                {
  387.                fp[ n ] = (float) 0.0;
  388.                }
  389.             break;
  390.          case DOUBLE:
  391.             dp = (double *) v->array;
  392.             for ( n = 0; n < v->array_units; ++n )
  393.                {
  394.                dp[ n ] = (double) 0.0;
  395.                }
  396.             break;
  397.          case INTEGER:
  398.             ip = (int *) v->array;
  399.             for ( n = 0; n < v->array_units; ++n )
  400.                {
  401.                ip[ n ] = 0;
  402.                }
  403.             break;
  404.          case STRING:
  405.             sp = (bstring *) v->array;
  406.             for ( n = 0; n < v->array_units; ++n )
  407.                {
  408.                if ( sp[ n ].buffer != NULL )
  409.                   {
  410.                   free( sp[ n ].buffer );
  411.                   sp[ n ].buffer = NULL;
  412.                   }
  413.                sp[ n ].rab = FALSE;
  414.                sp[ n ].length = 0;
  415.                }
  416.             break;
  417.          }
  418.       }
  419.  
  420.    return l;
  421.  
  422.    }
  423.  
  424. /***********************************************************
  425.  
  426.         Function:    var_delcvars()
  427.  
  428.         This function deletes all variables in memory except
  429.         those previously marked as common.
  430.  
  431. ***********************************************************/
  432.  
  433. int
  434. var_delcvars()
  435.    {
  436.    struct bwb_variable *v;
  437.    struct bwb_variable *p;        /* previous variable */
  438.  
  439.    p = &var_start;
  440.    for ( v = var_start.next; v != &var_end; v = v->next )
  441.       {
  442.  
  443.       if ( v->common != TRUE )
  444.          {
  445.  
  446.          /* if the variable is dimensioned, release allocated memory */
  447.  
  448.          if ( v->dimensions > 0 )
  449.             {
  450.  
  451.             /* deallocate memory */
  452.  
  453.             free( v->array_sizes );
  454.             free( v->array_pos );
  455.             free( v->array );
  456.  
  457.             }
  458.  
  459.          /* reassign linkage */
  460.  
  461.          p->next = v->next;
  462.  
  463.          /* deallocate the variable itself */
  464.  
  465.          free( v );
  466.  
  467.          }
  468.  
  469.       /* else reset previous variable */
  470.  
  471.       else
  472.          {
  473.          p = v;
  474.          }
  475.  
  476.       }
  477.  
  478.    return TRUE;
  479.  
  480.    }
  481.  
  482. /***********************************************************
  483.  
  484.         Function:    bwb_erase()
  485.  
  486.         This function implements the BASIC ERASE command.
  487.  
  488. ***********************************************************/
  489.  
  490. struct bwb_line *
  491. bwb_erase( struct bwb_line *l )
  492.    {
  493.    register int loop;
  494.    struct bwb_variable *v;
  495.    struct bwb_variable *p;        /* previous variable in linked list */
  496.    char tbuf[ MAXSTRINGSIZE + 1 ];
  497.  
  498.    /* loop while arguments are available */
  499.  
  500.    loop = TRUE;
  501.    while ( loop == TRUE )
  502.       {
  503.  
  504.       /* get variable name and find variable */
  505.  
  506.       bwb_getvarname( l->buffer, tbuf, &( l->position ) );
  507.  
  508.       if ( ( v = var_find( tbuf ) ) == NULL )
  509.          {
  510.          bwb_error( err_syntax );
  511.          return l;
  512.          }
  513.  
  514.       /* be sure the variable is dimensioned */
  515.  
  516.       if (( v->dimensions < 1 ) || ( v->array_sizes[ 0 ] < 1 ))
  517.      {
  518.      bwb_error( err_dimnotarray );
  519.      return l;
  520.          }
  521.  
  522.       /* find previous variable in chain */
  523.  
  524.       for ( p = &var_start; p->next != v; p = p->next )
  525.          {
  526.          ;
  527.          }
  528.  
  529.       /* reassign linkage */
  530.  
  531.       p->next = v->next;
  532.  
  533.       /* deallocate memory */
  534.  
  535.       free( v->array_sizes );
  536.       free( v->array_pos );
  537.       free( v->array );
  538.       free( v );
  539.  
  540.       /* check for comma */
  541.  
  542.       adv_ws( l->buffer, &( l->position ) );
  543.       if ( l->buffer[ l->position ] != ',' )
  544.          {
  545.          return l;                /* no comma; leave */
  546.          }
  547.       ++( l->position );
  548.       adv_ws( l->buffer, &( l->position ) );
  549.  
  550.       }
  551.  
  552.    }
  553.  
  554. /***********************************************************
  555.  
  556.         Function:    bwb_swap()
  557.  
  558.         This function implements the BASIC SWAP command.
  559.  
  560. ***********************************************************/
  561.  
  562. struct bwb_line *
  563. bwb_swap( struct bwb_line *l )
  564.    {
  565.    struct bwb_variable *v;            /* temp holder */
  566.    struct bwb_variable *lhs, *rhs;        /* left and right- hand side of swap statement */
  567.    char tbuf[ MAXSTRINGSIZE + 1 ];
  568.  
  569.    #if INTENSIVE_DEBUG
  570.    sprintf( bwb_ebuf, "in bwb_swap(): buffer is <%s>",
  571.       &( l->buffer[ l->position ] ) );
  572.    bwb_debug( bwb_ebuf );
  573.    #endif
  574.  
  575.    /* get left variable name and find variable */
  576.  
  577.    bwb_getvarname( l->buffer, tbuf, &( l->position ) );
  578.  
  579.    #if INTENSIVE_DEBUG
  580.    sprintf( bwb_ebuf, "in bwb_swap(): tbuf is <%s>", tbuf );
  581.    bwb_debug( bwb_ebuf );
  582.    #endif
  583.  
  584.    if ( ( lhs = var_find( tbuf ) ) == NULL )
  585.       {
  586.       bwb_error( err_syntax );
  587.       return l;
  588.       }
  589.  
  590.    #if INTENSIVE_DEBUG
  591.    sprintf( bwb_ebuf, "in bwb_swap(): lhs variable <%s> found",
  592.       lhs->name );
  593.    bwb_debug( bwb_ebuf );
  594.    #endif
  595.  
  596.    /* check for comma */
  597.  
  598.    adv_ws( l->buffer, &( l->position ) );
  599.    if ( l->buffer[ l->position ] != ',' )
  600.       {
  601.       bwb_error( err_syntax );
  602.       return l;
  603.       }
  604.    ++( l->position );
  605.    adv_ws( l->buffer, &( l->position ) );
  606.  
  607.    /* get right variable name */
  608.  
  609.    #if INTENSIVE_DEBUG
  610.    sprintf( bwb_ebuf, "in bwb_swap(): buffer is now <%s>",
  611.       &( l->buffer[ l->position ] ) );
  612.    bwb_debug( bwb_ebuf );
  613.    #endif
  614.  
  615.    bwb_getvarname( l->buffer, tbuf, &( l->position ) );
  616.  
  617.    #if INTENSIVE_DEBUG
  618.    sprintf( bwb_ebuf, "in bwb_swap(): tbuf is <%s>", tbuf );
  619.    bwb_debug( bwb_ebuf );
  620.    #endif
  621.  
  622.    if ( ( rhs = var_find( tbuf ) ) == NULL )
  623.       {
  624.       bwb_error( err_syntax );
  625.       return l;
  626.       }
  627.  
  628.    /* check to be sure that both variables are of the same type */
  629.  
  630.    if ( rhs->type != lhs->type )
  631.       {
  632.       bwb_error( err_mismatch );
  633.       return l;
  634.       }
  635.  
  636.    /* copy lhs to temp, rhs to lhs, then temp to rhs */
  637.  
  638.    memcpy( &v,  lhs, sizeof( struct bwb_variable ));
  639.    memcpy( lhs, rhs, sizeof( struct bwb_variable ));
  640.    memcpy( rhs, &v,  sizeof( struct bwb_variable ));
  641.  
  642.    /* return */
  643.  
  644.    return l;
  645.  
  646.    }
  647.  
  648. /***********************************************************
  649.  
  650.         bwb_const()
  651.  
  652.         This function takes the string in lb (the large buffer),
  653.         finds a string constant (beginning and ending with 
  654.         quotation marks), and returns it in sb (the small
  655.         buffer), appropriately incrementing the integer
  656.         pointed to by n. The string in lb should NOT include
  657.         the initial quotation mark.
  658.  
  659. ***********************************************************/
  660.  
  661. bwb_const( char *lb, char *sb, int *n )
  662.    {
  663.    register int s;
  664.  
  665.    ++*n;                        /* advance past quotation mark */
  666.    s = 0;
  667.  
  668.    while ( TRUE )
  669.       {
  670.       switch ( lb[ *n ] )
  671.          {
  672.          case '\"':
  673.             sb[ s ] = 0;
  674.             ++*n;               /* advance past ending quotation mark */
  675.             return TRUE;
  676.          case '\n':
  677.          case '\r':
  678.          case 0:
  679.             sb[ s ] = 0;
  680.             return TRUE;
  681.          default:
  682.             sb[ s ] = lb[ *n ];
  683.             break;
  684.          }
  685.  
  686.       ++*n;                     /* advance to next character in large buffer */
  687.       ++s;                      /* advance to next position in small buffer */
  688.       sb[ s ] = 0;              /* terminate with 0 */
  689.       }
  690.  
  691.    }
  692.  
  693. /***********************************************************
  694.  
  695.         bwb_getvarname()
  696.  
  697.         This function takes the string in lb (the large buffer),
  698.         finds a variable name, and returns it in sb (the
  699.         small buffer), appropriately incrementing the integer
  700.         pointed to by n.
  701.  
  702. ***********************************************************/
  703.  
  704. bwb_getvarname( char *lb, char *sb, int *n )
  705.    {
  706.    register int s;
  707.  
  708.    s = 0;
  709.  
  710.    /* advance beyond whitespace */
  711.  
  712.    adv_ws( lb, n );
  713.  
  714.    while ( TRUE )
  715.       {
  716.       switch ( lb[ *n ] )
  717.          {
  718.          case ' ':              /* whitespace */
  719.          case '\t':
  720.          case '\n':             /* end of string */
  721.          case '\r':
  722.          case 0:
  723.          case ':':              /* end of expression */
  724.          case ',':
  725.          case ';':
  726.          case '(':              /* beginning of parameter list for dimensioned array */
  727.          case '+':              /* add variables */
  728.             sb[ s ] = 0;
  729.             return TRUE;
  730.          default:
  731.             sb[ s ] = lb[ *n ];
  732.             break;
  733.          }
  734.  
  735.       ++*n;                     /* advance to next character in large buffer */
  736.       ++s;                      /* advance to next position in small buffer */
  737.       sb[ s ] = 0;              /* terminate with 0 */
  738.  
  739.       #if INTENSIVE_DEBUG
  740.       sprintf( bwb_ebuf, "in bwb_getvarname(): found <%s>", sb );
  741.       bwb_debug( bwb_ebuf );
  742.       #endif
  743.       }
  744.  
  745.    }
  746.  
  747. /***************************************************************
  748.  
  749.         FUNCTION:       var_find()
  750.  
  751.         DESCRIPTION:
  752.  
  753. ***************************************************************/
  754.  
  755. struct bwb_variable *
  756. var_find( char *buffer )
  757.    {
  758.    struct bwb_variable *v;
  759.    size_t array_size;
  760.  
  761.    #if INTENSIVE_DEBUG
  762.    sprintf( bwb_ebuf, "in var_find(): received <%s>", buffer );
  763.    bwb_debug( bwb_ebuf );
  764.    #endif
  765.  
  766.    /* first, run through the variable list and try to find a match */
  767.  
  768.    for ( v = var_start.next; v != &var_end; v = v->next )
  769.       {
  770.  
  771.       if ( strcmp( v->name, buffer ) == 0 )
  772.          {
  773.          switch( v->type )
  774.             {
  775.             case STRING:
  776.             case DOUBLE:
  777.             case INTEGER:
  778.             case SINGLE:
  779.                break;
  780.             default:
  781.                #if INTENSIVE_DEBUG
  782.                sprintf( bwb_ebuf, "in var_find(): inappropriate precision for variable <%s>",
  783.                   v->name );
  784.                bwb_error( bwb_ebuf );
  785.                #endif
  786.                break;
  787.             }
  788.          #if INTENSIVE_DEBUG
  789.          sprintf( bwb_ebuf, "in var_find(): found existing variable <%s>", v->name );
  790.          bwb_debug( bwb_ebuf );
  791.          #endif
  792.  
  793.          return v;
  794.          }
  795.  
  796.       }
  797.  
  798.    /* presume this is a new variable, so initialize it... */
  799.    /* check for NULL variable name */
  800.  
  801.    if ( strlen( buffer ) == 0 )
  802.       {
  803.       #if PROG_ERRORS
  804.       sprintf( bwb_ebuf, "in var_find(): NULL variable name received\n" );
  805.       bwb_error( bwb_ebuf );
  806.       #else
  807.       bwb_error( err_syntax );
  808.       #endif
  809.       return NULL;
  810.       }
  811.  
  812.    /* get memory for new variable */
  813.  
  814.    if ( ( v = (struct bwb_variable *) calloc( 1, sizeof( struct bwb_variable ) )) 
  815.       == NULL )
  816.       {
  817.       bwb_error( err_getmem );
  818.       return NULL;
  819.       }
  820.  
  821.    /* get memory for new variable name */
  822.  
  823.    #if ALLOCATE_NAME
  824.    if ( ( v->name = (char *) calloc( 1, strlen( buffer ) + 1 )) 
  825.       == NULL )
  826.       {
  827.       bwb_error( err_getmem );
  828.       return NULL;
  829.       }
  830.    #endif
  831.  
  832.    /* copy the name into the appropriate structure */
  833.  
  834.    strcpy( v->name, buffer );
  835.  
  836.    /* set memory in the new variable */
  837.  
  838.    var_make( v, (int) v->name[ strlen( v->name ) - 1 ] );
  839.  
  840.    /* set place at beginning of variable chain */
  841.  
  842.    v->next = var_start.next;
  843.    var_start.next = v;
  844.  
  845.    #if INTENSIVE_DEBUG
  846.    sprintf( bwb_ebuf, "in var_find(): initialized new variable <%s> type <%c>, dim <%d>",
  847.       v->name, v->type, v->dimensions );
  848.    bwb_debug( bwb_ebuf );
  849.    #endif
  850.  
  851.    return v;
  852.  
  853.    }
  854.  
  855. /***************************************************************
  856.  
  857.         FUNCTION:       bwb_isvar()
  858.  
  859.         DESCRIPTION:
  860.  
  861. ***************************************************************/
  862.  
  863. int
  864. bwb_isvar( char *buffer )
  865.    {
  866.    struct bwb_variable *v;
  867.  
  868.    /* run through the variable list and try to find a match */
  869.  
  870.    for ( v = var_start.next; v != &var_end; v = v->next )
  871.       {
  872.  
  873.       if ( strcmp( v->name, buffer ) == 0 )
  874.          {
  875.          return TRUE;
  876.          }
  877.  
  878.       }
  879.  
  880.    /* search failed */
  881.  
  882.    return FALSE;
  883.  
  884.    }
  885.  
  886. /***************************************************************
  887.  
  888.         FUNCTION:   var_getdval()
  889.  
  890.         DESCRIPTION:  This function returns the current value of
  891.         the variable argument as a double precision number.
  892.  
  893. ***************************************************************/
  894.  
  895. double
  896. var_getdval( struct bwb_variable *nvar )
  897.    {
  898.  
  899.    switch( nvar->type )
  900.       {
  901.       case DOUBLE:
  902.          return *( var_finddval( nvar, nvar->array_pos ) );
  903.       case SINGLE:
  904.          return (double) *( var_findfval( nvar, nvar->array_pos ) );
  905.       case INTEGER:
  906.          return (double) *( var_findival( nvar, nvar->array_pos ) );
  907.       }
  908.  
  909.    #if PROG_ERRORS
  910.    sprintf( bwb_ebuf, "in var_getdval(): type is <%d>=<%c>.",
  911.       nvar->type, nvar->type );
  912.    bwb_error( bwb_ebuf );
  913.    #else
  914.    bwb_error( err_mismatch );
  915.    #endif
  916.  
  917.  
  918.    return (double) 0.0;
  919.  
  920.    }
  921.  
  922. /***************************************************************
  923.  
  924.         FUNCTION:   var_getfval()
  925.  
  926.         DESCRIPTION:  This function returns the current value of
  927.         the variable argument as a single precision number (float).
  928.  
  929. ***************************************************************/
  930.  
  931. float
  932. var_getfval( struct bwb_variable *nvar )
  933.    {
  934.  
  935.    #if INTENSIVE_DEBUG
  936.    sprintf( bwb_ebuf, "in var_getfval(): variable <%s>, type <%c>",
  937.       nvar->name, nvar->type );
  938.    bwb_debug( bwb_ebuf );
  939.    #endif
  940.  
  941.    switch( nvar->type )
  942.       {
  943.       case DOUBLE:
  944.          return (float) *( var_finddval( nvar, nvar->array_pos ) );
  945.       case SINGLE:
  946.          return *( var_findfval( nvar, nvar->array_pos ) );
  947.       case INTEGER:
  948.          return (float) *( var_findival( nvar, nvar->array_pos ) );
  949.       }
  950.  
  951.    #if PROG_ERRORS
  952.    sprintf( bwb_ebuf, "in var_getfval(): type is <%d>=<%c>.",
  953.       nvar->type, nvar->type );
  954.    bwb_error( bwb_ebuf );
  955.    #else
  956.    bwb_error( err_mismatch );
  957.    #endif
  958.  
  959.    return (float) 0.0;
  960.  
  961.    }
  962.  
  963. /***************************************************************
  964.  
  965.         FUNCTION:   var_getival()
  966.  
  967.         DESCRIPTION:  This function returns the current value of
  968.         the variable argument as an integer.
  969.  
  970. ***************************************************************/
  971.  
  972. int
  973. var_getival( struct bwb_variable *nvar )
  974.    {
  975.  
  976.    switch( nvar->type )
  977.       {
  978.       case DOUBLE:
  979.          return (int) *( var_finddval( nvar, nvar->array_pos ) );
  980.       case SINGLE:
  981.  
  982.          #if INTENSIVE_DEBUG
  983.          sprintf( bwb_ebuf, "in var_getival(): float <%f> -> int <%d>",
  984.             nvar->fval, (int) nvar->fval );
  985.          bwb_debug( bwb_ebuf );
  986.          #endif
  987.  
  988.          return (int) *( var_findfval( nvar, nvar->array_pos ) );
  989.       case INTEGER:
  990.          return *( var_findival( nvar, nvar->array_pos ) );
  991.       }
  992.  
  993.    #if PROG_ERRORS
  994.    sprintf( bwb_ebuf, "in var_getival(): type is <%d>=<%c>.",
  995.       nvar->type, nvar->type );
  996.    bwb_error( bwb_ebuf );
  997.    #else
  998.    bwb_error( err_mismatch );
  999.    #endif
  1000.  
  1001.    return 0;
  1002.  
  1003.    }
  1004.  
  1005. /***************************************************************
  1006.  
  1007.         FUNCTION:   var_getsval()
  1008.  
  1009.         DESCRIPTION:  This function returns the current value of
  1010.         the variable argument as a pointer to a BASIC string
  1011.         structure.
  1012.  
  1013. ***************************************************************/
  1014.  
  1015. bstring *
  1016. var_getsval( struct bwb_variable *nvar )
  1017.    {
  1018.    static bstring b;
  1019.  
  1020.    b.rab = FALSE;
  1021.  
  1022.    switch( nvar->type )
  1023.       {
  1024.       case STRING:
  1025.          return var_findsval( nvar, nvar->array_pos );
  1026.       case DOUBLE:
  1027.          sprintf( bwb_ebuf, "%*f ", prn_precision( nvar ),
  1028.             *( var_finddval( nvar, nvar->array_pos ) ) );
  1029.          str_ctob( &b, bwb_ebuf );
  1030.          return &b;
  1031.       case SINGLE:
  1032.          sprintf( bwb_ebuf, "%*f ", prn_precision( nvar ),
  1033.             *( var_findfval( nvar, nvar->array_pos ) ) );
  1034.          str_ctob( &b, bwb_ebuf );
  1035.          return &b;
  1036.       case INTEGER:
  1037.          sprintf( bwb_ebuf, "%d ", *( var_findival( nvar, nvar->array_pos ) ) );
  1038.          str_ctob( &b, bwb_ebuf );
  1039.          return &b;
  1040.       default:
  1041.          #if PROG_ERRORS
  1042.          sprintf( bwb_ebuf, "in var_getsval(): type is <%d>=<%c>.",
  1043.             nvar->type, nvar->type );
  1044.          bwb_error( bwb_ebuf );
  1045.          #else
  1046.          bwb_error( err_mismatch );
  1047.          #endif
  1048.          return NULL;
  1049.       }
  1050.  
  1051.    }
  1052.  
  1053. /***************************************************************
  1054.  
  1055.         FUNCTION:       bwb_dim()
  1056.  
  1057.         DESCRIPTION:    This function implements the BASIC DIM
  1058.                         statement, allocating memory for a
  1059.                         dimensioned array of variables.
  1060.  
  1061. ***************************************************************/
  1062.  
  1063. struct bwb_line *
  1064. bwb_dim( struct bwb_line *l )
  1065.    {
  1066.    register int n;
  1067.    static int n_params;                         /* number of parameters */
  1068.    static int *pp;                              /* pointer to parameter values */
  1069.    struct bwb_variable *newvar;
  1070.    double *d;
  1071.    float *f;
  1072.    int *i;
  1073.    int loop;
  1074.    int old_name, old_dimensions;
  1075.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1076.  
  1077.    #if INTENSIVE_DEBUG
  1078.    sprintf( bwb_ebuf, "in bwb_dim(): entered function." );
  1079.    bwb_debug( bwb_ebuf );
  1080.    #endif
  1081.  
  1082.    loop = TRUE;
  1083.    while ( loop == TRUE )
  1084.       {
  1085.  
  1086.       old_name = FALSE;
  1087.  
  1088.       /* Get variable name */
  1089.  
  1090.       adv_ws( l->buffer, &( l->position ) );
  1091.       bwb_getvarname( l->buffer, tbuf, &( l->position ) );
  1092.  
  1093.       /* check for previously used variable name */
  1094.  
  1095.       if ( bwb_isvar( tbuf ) == TRUE )
  1096.          {
  1097.          #if INTENSIVE_DEBUG
  1098.          sprintf( bwb_ebuf, "in bwb_dim(): variable name is already used.",
  1099.             l->number );
  1100.          bwb_debug( bwb_ebuf );
  1101.          #endif
  1102.          old_name = TRUE;
  1103.          }
  1104.  
  1105.       /* get the new variable */
  1106.  
  1107.       newvar = var_find( tbuf );
  1108.  
  1109.       #if INTENSIVE_DEBUG
  1110.       sprintf( bwb_ebuf, "in bwb_dim(): new variable name is <%s>.",
  1111.          newvar->name );
  1112.       bwb_debug( bwb_ebuf );
  1113.       #endif
  1114.  
  1115.       /* note that DIM has been called */
  1116.  
  1117.       dimmed = TRUE;
  1118.  
  1119.       /* read parameters */
  1120.  
  1121.       old_dimensions = newvar->dimensions;
  1122.       dim_getparams( l->buffer, &( l->position ), &n_params, &pp );
  1123.       newvar->dimensions = n_params;
  1124.  
  1125.       /* Check parameters for an old variable name */
  1126.  
  1127.       if ( old_name == TRUE )
  1128.          {
  1129.  
  1130.          /* check to be sure the number of dimensions is the same */
  1131.  
  1132.          if ( newvar->dimensions != old_dimensions )
  1133.             {
  1134.             #if PROG_ERRORS
  1135.             sprintf( bwb_ebuf, "in bwb_dim(): variable <%s> cannot be re-dimensioned",
  1136.                newvar->name );
  1137.             bwb_error( bwb_ebuf );
  1138.             #else
  1139.             bwb_error( err_redim );
  1140.             #endif
  1141.             }
  1142.  
  1143.          /* check to be sure sizes for the old variable are the same */
  1144.  
  1145.          for ( n = 0; n < newvar->dimensions; ++n )
  1146.             {
  1147.             #if INTENSIVE_DEBUG
  1148.             sprintf( bwb_ebuf, "in bwb_dim(): old var <%s> parameter <%d> size <%d>.",
  1149.                newvar->name, n, pp[ n ] );
  1150.             bwb_debug( bwb_ebuf );
  1151.             #endif
  1152.             if ( ( pp[ n ] + ( 1 - dim_base )) != newvar->array_sizes[ n ] )
  1153.                {
  1154.                #if PROG_ERRORS
  1155.                sprintf( bwb_ebuf, "in bwb_dim(): variable <%s> parameter <%d> cannot be resized",
  1156.                   newvar->name, n );
  1157.                bwb_error( bwb_ebuf );
  1158.                #else
  1159.                bwb_error( err_redim );
  1160.                #endif
  1161.                }
  1162.             }
  1163.  
  1164.          }         /* end of conditional for old variable */
  1165.  
  1166.  
  1167.       /* a new variable */
  1168.  
  1169.       else
  1170.          {
  1171.  
  1172.          /* assign memory for parameters */
  1173.  
  1174.          if ( ( newvar->array_sizes = (int *) calloc( n_params, sizeof( int )  )) == NULL )
  1175.             {
  1176.             #if PROG_ERRORS
  1177.             sprintf( bwb_ebuf, "in line %d: Failed to find memory for array_sizes for <%s>",
  1178.                l->number, newvar->name );
  1179.             bwb_error( bwb_ebuf );
  1180.             #else
  1181.             bwb_error( err_getmem );
  1182.             #endif
  1183.             l->next->position = 0;
  1184.             return l->next;
  1185.             }
  1186.  
  1187.          for ( n = 0; n < newvar->dimensions; ++n )
  1188.             {
  1189.             newvar->array_sizes[ n ] = pp[ n ] + ( 1 - dim_base );
  1190.             #if INTENSIVE_DEBUG
  1191.             sprintf( bwb_ebuf, "in bwb_dim(): array_sizes dim <%d> value <%d>",
  1192.                n, newvar->array_sizes[ n ] );
  1193.             bwb_debug( bwb_ebuf );
  1194.             #endif
  1195.             }
  1196.  
  1197.          /* assign memory for current position */
  1198.  
  1199.          if ( ( newvar->array_pos = (int *) calloc( n_params, sizeof( int ) )) == NULL )
  1200.             {
  1201.             #if PROG_ERRORS
  1202.             sprintf( bwb_ebuf, "in line %d: Failed to find memory for array_pos for <%s>",
  1203.                l->number, newvar->name );
  1204.             bwb_error( bwb_ebuf );
  1205.             #else
  1206.             bwb_error( err_getmem );
  1207.             #endif
  1208.             l->next->position = 0;
  1209.             return l->next;
  1210.             }
  1211.  
  1212.          for ( n = 0; n < newvar->dimensions; ++n )
  1213.             {
  1214.             newvar->array_pos[ n ] = dim_base;
  1215.             }
  1216.  
  1217.          /* calculate the array size */
  1218.  
  1219.          newvar->array_units = (size_t) MAXINTSIZE;    /* avoid error in dim_unit() */
  1220.          newvar->array_units = dim_unit( newvar, pp ) + 1;
  1221.  
  1222.          #if INTENSIVE_DEBUG
  1223.          sprintf( bwb_ebuf, "in bwb_dim(): array memory requires <%ld> units",
  1224.             (long) newvar->array_units );
  1225.          bwb_debug( bwb_ebuf );
  1226.          #endif
  1227.  
  1228.          /* assign array memory */
  1229.  
  1230.          switch( newvar->type )
  1231.             {
  1232.             case STRING:
  1233.                #if INTENSIVE_DEBUG
  1234.                sprintf( bwb_ebuf, "in bwb_dim(): 1 STRING requires <%ld> bytes",
  1235.                   (long) sizeof( bstring ));
  1236.                bwb_debug( bwb_ebuf );
  1237.                sprintf( bwb_ebuf, "in bwb_dim(): STRING array memory requires <%ld> bytes",
  1238.               (long) ( newvar->array_units + 1 ) * sizeof( bstring ));
  1239.                bwb_debug( bwb_ebuf );
  1240.                #endif
  1241.                if ( ( newvar->array = (char *) calloc( newvar->array_units, sizeof( bstring) )) == NULL )
  1242.                   {
  1243.                   #if PROG_ERRORS
  1244.                   sprintf( bwb_ebuf, "in line %d: Failed to find memory for array <%s>",
  1245.                      l->number, newvar->name );
  1246.                   bwb_error( bwb_ebuf );
  1247.                   #else
  1248.                   bwb_error( err_getmem );
  1249.                   #endif
  1250.                   l->next->position = 0;
  1251.                   return l->next;
  1252.                   }
  1253.                break;
  1254.             case DOUBLE:
  1255.                #if INTENSIVE_DEBUG
  1256.                sprintf( bwb_ebuf, "in bwb_dim(): 1 DOUBLE requires <%ld> bytes",
  1257.                   (long) sizeof( double ));
  1258.                bwb_debug( bwb_ebuf );
  1259.                sprintf( bwb_ebuf, "in bwb_dim(): DOUBLE array memory requires <%ld> bytes",
  1260.               (long) ( newvar->array_units + 1 ) * sizeof( double ));
  1261.                bwb_debug( bwb_ebuf );
  1262.                #endif
  1263.                if ( ( d = (double *) calloc( newvar->array_units, sizeof( double ) )) == NULL )
  1264.                   {
  1265.                   #if PROG_ERRORS
  1266.                   sprintf( bwb_ebuf, "in line %d: Failed to find memory for array <%s>",
  1267.                   l->number, newvar->name );
  1268.                   bwb_error( bwb_ebuf );
  1269.                   #else
  1270.                   bwb_error( err_getmem );
  1271.                   #endif
  1272.                   l->next->position = 0;
  1273.                   return l->next;
  1274.                   }
  1275.                newvar->array = (char *) d;
  1276.                break;
  1277.             case SINGLE:
  1278.                #if INTENSIVE_DEBUG
  1279.                sprintf( bwb_ebuf, "in bwb_dim(): 1 SINGLE requires <%ld> bytes",
  1280.                   (long) sizeof( float ));
  1281.                bwb_debug( bwb_ebuf );
  1282.                sprintf( bwb_ebuf, "in bwb_dim(): SINGLE array memory requires <%ld> bytes",
  1283.               (long) ( newvar->array_units + 1 ) * sizeof( float ));
  1284.                bwb_debug( bwb_ebuf );
  1285.                #endif
  1286.                if ( ( f = (float *) calloc( newvar->array_units, sizeof( float ) )) == NULL )
  1287.                   {
  1288.                   #if PROG_ERRORS
  1289.                   sprintf( bwb_ebuf, "in line %d: Failed to find memory for array <%s>",
  1290.                      l->number, newvar->name );
  1291.                   bwb_error( bwb_ebuf );
  1292.                   #else
  1293.                   bwb_error( err_getmem );
  1294.                   #endif
  1295.                   l->next->position = 0;
  1296.                   return l->next;
  1297.                   }
  1298.                newvar->array = (char *) f;
  1299.                break;
  1300.             case INTEGER:
  1301.                #if INTENSIVE_DEBUG
  1302.                sprintf( bwb_ebuf, "in bwb_dim(): 1 INTEGER requires <%ld> bytes",
  1303.                   (long) sizeof( int ));
  1304.                bwb_debug( bwb_ebuf );
  1305.                sprintf( bwb_ebuf, "in bwb_dim(): INTEGER array memory requires <%ld> bytes",
  1306.               (long) ( newvar->array_units + 1 ) * sizeof( int ));
  1307.                bwb_debug( bwb_ebuf );
  1308.                #endif
  1309.                if ( ( i = (int *) calloc( newvar->array_units, sizeof( int ) )) == NULL )
  1310.                   {
  1311.                   #if PROG_ERRORS
  1312.                   sprintf( bwb_ebuf, "in line %d: Failed to find memory for array <%s>",
  1313.                      l->number, newvar->name );
  1314.                   bwb_error( bwb_ebuf );
  1315.                   #else
  1316.                   bwb_error( err_getmem );
  1317.                   #endif
  1318.                   l->next->position = 0;
  1319.                   return l->next;
  1320.                   }
  1321.                newvar->array = (char *) i;
  1322.                break;
  1323.             default:
  1324.                #if PROG_ERRORS
  1325.                sprintf( bwb_ebuf, "in line %d: New variable has unrecognized type.",
  1326.                   l->number );
  1327.                bwb_error( bwb_ebuf );
  1328.                #else
  1329.                bwb_error( err_syntax );
  1330.                #endif
  1331.                l->next->position = 0;
  1332.                return l->next;
  1333.             }
  1334.  
  1335.          }            /* end of conditional for new variable */
  1336.  
  1337.       /* now check for end of string */
  1338.  
  1339.       if ( l->buffer[ l->position ] == ')' )
  1340.          {
  1341.          ++( l->position );
  1342.          }
  1343.       adv_ws( l->buffer, &( l->position ));
  1344.       switch( l->buffer[ l->position ] )
  1345.          {
  1346.          case '\n':            /* end of line */
  1347.          case '\r':
  1348.          case ':':            /* end of line segment */
  1349.          case '\0':            /* end of string */
  1350.             loop = FALSE;
  1351.             break;
  1352.          case ',':
  1353.             ++( l->position );
  1354.             adv_ws( l->buffer, &( l->position ) );
  1355.             loop = TRUE;
  1356.             break;
  1357.          default:
  1358.             #if PROG_ERRORS
  1359.             sprintf( bwb_ebuf, "in bwb_dim(): unexpected end of string, buf <%s>",
  1360.                &( l->buffer[ l->position ] ) );
  1361.             bwb_error( bwb_ebuf );
  1362.             #else
  1363.             bwb_error( err_syntax );
  1364.             #endif
  1365.             loop = FALSE;
  1366.             break;
  1367.          }
  1368.  
  1369.       }                /* end of loop through variables */
  1370.  
  1371.    /* return */
  1372.  
  1373.    l->next->position = 0;
  1374.    return l->next;
  1375.  
  1376.    }
  1377.  
  1378. /***************************************************************
  1379.  
  1380.         FUNCTION:       dim_unit()
  1381.  
  1382.         DESCRIPTION:    This function calculates the unit
  1383.                 position for an array.
  1384.  
  1385. ***************************************************************/
  1386.  
  1387. size_t
  1388. dim_unit( struct bwb_variable *v, int *pp )
  1389.    {
  1390.    size_t r;
  1391.    size_t b;
  1392.    register int n;
  1393.  
  1394.    /* Calculate and return the address of the dimensioned array */
  1395.  
  1396.    b = 1;
  1397.    r = 0;
  1398.    for ( n = 0; n < v->dimensions; ++n )
  1399.       {
  1400.       r += b * ( pp[ n ] - dim_base );
  1401.       b *= v->array_sizes[ n ];
  1402.       }
  1403.  
  1404.    #if INTENSIVE_DEBUG
  1405.    for ( n = 0; n < v->dimensions; ++n )
  1406.       {
  1407.       sprintf( bwb_ebuf,
  1408.          "in dim_unit(): variable <%s> pos <%d> val <%d>.",
  1409.          v->name, n, pp[ n ] );
  1410.       bwb_debug( bwb_ebuf );
  1411.       }
  1412.    sprintf( bwb_ebuf, "in dim_unit(): return unit: <%ld>", (long) r );
  1413.    bwb_debug( bwb_ebuf );
  1414.    #endif
  1415.  
  1416.    if ( r > v->array_units )
  1417.       {
  1418.       #if PROG_ERRORS
  1419.       sprintf( bwb_ebuf, "in dim_unit(): unit value <%ld> exceeds array units <%ld>",
  1420.          r, v->array_units );
  1421.       bwb_error( bwb_ebuf );
  1422.       #else
  1423.       bwb_error( err_valoorange );
  1424.       #endif
  1425.       return 0;
  1426.       }
  1427.  
  1428.    return r;
  1429.  
  1430.    }
  1431.  
  1432. /***************************************************************
  1433.  
  1434.         FUNCTION:       dim_getparams()
  1435.  
  1436.         DESCRIPTION:    This fuunction reads a string in <buffer>
  1437.                         beginning at position <pos> and finds a
  1438.                         list of parameters surrounded by paren-
  1439.                         theses, returning in <n_params> the number
  1440.                         of parameters found, and returning in
  1441.                         <pp> an array of n_params integers giving
  1442.                         the sizes for each dimension of the array.
  1443.  
  1444. ***************************************************************/
  1445.  
  1446. int
  1447. dim_getparams( char *buffer, int *pos, int *n_params, int **pp )
  1448.    {
  1449.    int loop;
  1450.    static int params[ MAX_DIMS ];
  1451.    int x_pos, s_pos;
  1452.    int paren_found;
  1453.    register int n;
  1454.    struct exp_ese *e;
  1455.    char tbuf[ MAXSTRINGSIZE + 1 ];
  1456.  
  1457.    /* set initial values */
  1458.  
  1459.    *n_params = 0;
  1460.    paren_found = FALSE;
  1461.  
  1462.    /* find open parenthesis */
  1463.  
  1464.    loop = TRUE;
  1465.    while ( loop == TRUE )
  1466.       {
  1467.  
  1468.       #if INTENSIVE_DEBUG
  1469.       sprintf( bwb_ebuf, "in dim_getparams(): eval char <%c = 0x%x>",
  1470.          buffer[ *pos ], buffer[ *pos ] );
  1471.       bwb_debug( bwb_ebuf );
  1472.       #endif
  1473.  
  1474.       switch( buffer[ *pos ] )
  1475.          {
  1476.          case '\0':                     /* end of line */
  1477.          case '\n':
  1478.          case '\r':
  1479.             #if PROG_ERRORS
  1480.             sprintf( bwb_ebuf, "Unexpected end of line in dimensioned variable." );
  1481.             bwb_error ( bwb_ebuf );
  1482.             #else
  1483.             bwb_error( err_syntax );
  1484.             #endif
  1485.         return FALSE;
  1486.             break;
  1487.          case ' ':                      /* whitespace */
  1488.          case '\t':
  1489.             if ( paren_found == FALSE )
  1490.                {
  1491.                ++(*pos);
  1492.                *n_params = 1;
  1493.                params[ 0 ] = dim_base;
  1494.                *pp = params;
  1495.                free( tbuf );
  1496.                return TRUE;
  1497.                }
  1498.             else
  1499.                {
  1500.                ++(*pos);
  1501.                }
  1502.             break;
  1503.  
  1504.          case '(':                      /* the open parenthesis */
  1505.             ++(*pos);
  1506.             paren_found = TRUE;
  1507.             loop = FALSE;
  1508.             #if INTENSIVE_DEBUG
  1509.             sprintf( bwb_ebuf, "in dim_getparams(): open parenthesis found (1)." );
  1510.             bwb_debug( bwb_ebuf );
  1511.             #endif
  1512.             break;
  1513.  
  1514.          default:            /* any other character */
  1515.             #if PROG_ERRORS
  1516.             sprintf( bwb_ebuf, "in dim_getparams(): illegal char <%c = 0x%x> in dimensioned variable.",
  1517.                buffer[ *pos ], buffer[ *pos ] );
  1518.             bwb_error ( bwb_ebuf );
  1519.             #else
  1520.             bwb_error( err_syntax );
  1521.             #endif
  1522.         return FALSE;
  1523.          }
  1524.       }
  1525.  
  1526.    #if INTENSIVE_DEBUG
  1527.    sprintf( bwb_ebuf, "in dim_getparams(): open parenthesis found (2)." );
  1528.    bwb_debug( bwb_ebuf );
  1529.    #endif
  1530.  
  1531.    /* Find each parameter */
  1532.  
  1533.    s_pos = 0;
  1534.    tbuf[ 0 ] = '\0';
  1535.    loop = TRUE;
  1536.    while( loop == TRUE )
  1537.       {
  1538.       switch( buffer[ *pos ] )
  1539.          {
  1540.          case ')':                      /* end of parameter list */
  1541.             x_pos = 0;
  1542.             if ( tbuf[ 0 ] == '\0' )
  1543.                {
  1544.                params[ *n_params ] = DEF_SUBSCRIPT;
  1545.                }
  1546.             else
  1547.                {
  1548.                #if INTENSIVE_DEBUG
  1549.                sprintf( bwb_ebuf, "in dim_getparams(): call bwb_exp() for last element" );
  1550.                bwb_debug( bwb_ebuf );
  1551.                #endif
  1552.                e = bwb_exp( tbuf, FALSE, &x_pos );
  1553.                #if INTENSIVE_DEBUG
  1554.                sprintf( bwb_ebuf, "in dim_getparams(): return from bwb_exp() for last element" );
  1555.                bwb_debug( bwb_ebuf );
  1556.                #endif
  1557.                params[ *n_params ] = exp_getival( e );
  1558.                }
  1559.             ++(*n_params);
  1560.             loop = FALSE;
  1561.             ++( *pos );
  1562.             break;
  1563.  
  1564.          case ',':                      /* end of a parameter */
  1565.             x_pos = 0;
  1566.             if ( tbuf[ 0 ] == '\0' )
  1567.                {
  1568.                params[ *n_params ] = DEF_SUBSCRIPT;
  1569.                }
  1570.             else
  1571.                {
  1572.                #if INTENSIVE_DEBUG
  1573.                sprintf( bwb_ebuf, "in dim_getparams(): call bwb_exp() for element (not last)" );
  1574.                bwb_debug( bwb_ebuf );
  1575.                #endif
  1576.                e = bwb_exp( tbuf, FALSE, &x_pos );
  1577.                params[ *n_params ] = exp_getival( e );
  1578.                }
  1579.             ++(*n_params);
  1580.             tbuf[ 0 ] = '\0';
  1581.             ++(*pos);
  1582.             s_pos = 0;
  1583.             break;
  1584.  
  1585.          case ' ':                      /* whitespace -- skip */
  1586.          case '\t':
  1587.             ++(*pos);
  1588.             break;
  1589.  
  1590.          default:
  1591.             tbuf[ s_pos ] = buffer[ *pos ];
  1592.             ++(*pos);
  1593.             ++s_pos;
  1594.             tbuf[ s_pos ] = '\0';
  1595.             break;
  1596.          }
  1597.       }
  1598.  
  1599.    #if INTENSIVE_DEBUG
  1600.    for ( n = 0; n < *n_params; ++n )
  1601.       {
  1602.       sprintf( bwb_ebuf, "in dim_getparams(): Parameter <%d>: <%d>",
  1603.          n, params[ n ] );
  1604.       bwb_debug( bwb_ebuf );
  1605.       }
  1606.    #endif
  1607.  
  1608.    /* return params stack */
  1609.  
  1610.    *pp = params;
  1611.  
  1612.    return TRUE;
  1613.  
  1614.    }
  1615.  
  1616. /***************************************************************
  1617.  
  1618.         FUNCTION:       bwb_option()
  1619.  
  1620.         DESCRIPTION:    This function implements the BASIC OPTION
  1621.                         BASE statement, designating the base (1 or
  1622.                         0) for addressing DIM arrays.
  1623.  
  1624. ***************************************************************/
  1625.  
  1626. struct bwb_line *
  1627. bwb_option( struct bwb_line *l )
  1628.    {
  1629.    register int n;
  1630.    int newval;
  1631.    struct exp_ese *e;
  1632.    struct bwb_variable *current;
  1633.    char tbuf[ MAXSTRINGSIZE ];
  1634.  
  1635.    #if INTENSIVE_DEBUG
  1636.    sprintf( bwb_ebuf, "in bwb_option(): entered function." );
  1637.    bwb_debug( bwb_ebuf );
  1638.    #endif
  1639.  
  1640.    /* If DIM has already been called, do not allow OPTION BASE */
  1641.  
  1642.    if ( dimmed != FALSE )
  1643.       {
  1644.       #if PROG_ERRORS
  1645.       sprintf( bwb_ebuf, "at line %d: OPTION BASE must be called before DIM.",
  1646.          l->number );
  1647.       bwb_error( bwb_ebuf );
  1648.       #else
  1649.       bwb_error( err_obdim );
  1650.       #endif
  1651.       l->next->position = 0;
  1652.       return l->next;
  1653.       }
  1654.  
  1655.    /* capitalize first element in tbuf */
  1656.  
  1657.    adv_element( l->buffer, &( l->position ), tbuf );
  1658.    for ( n = 0; tbuf[ n ] != '\0'; ++n )
  1659.       {
  1660.       if ( islower( tbuf[ n ] ) != FALSE )
  1661.          {
  1662.          tbuf[ n ] = toupper( tbuf[ n ] );
  1663.          }
  1664.       }
  1665.  
  1666.    /* check for BASE statement */
  1667.  
  1668.    if ( strncmp( tbuf, "BASE", (size_t) 4 ) != 0 )
  1669.       {
  1670.       #if PROG_ERRORS
  1671.       sprintf( bwb_ebuf, "at line %d: Unknown statement <%s> following OPTION.",
  1672.          l->number, tbuf );
  1673.       bwb_error( bwb_ebuf );
  1674.       #else
  1675.       bwb_error( err_syntax );
  1676.       #endif
  1677.       l->next->position = 0;
  1678.       return l->next;
  1679.       }
  1680.  
  1681.    /* Get new value from argument. */
  1682.  
  1683.    adv_ws( l->buffer, &( l->position ) );
  1684.    e = bwb_exp( l->buffer, FALSE, &( l->position ) );
  1685.    newval = exp_getival( e );
  1686.  
  1687.    /* Test the new value. */
  1688.  
  1689.    #if INTENSIVE_DEBUG
  1690.    sprintf( bwb_ebuf, "in bwb_option(): New value received is <%d>.", newval );
  1691.    bwb_debug( bwb_ebuf );
  1692.    #endif
  1693.  
  1694.    if ( ( newval < 0 ) || ( newval > 1 ) )
  1695.       {
  1696.       #if PROG_ERRORS
  1697.       sprintf( bwb_ebuf, "at line %d: value for OPTION BASE must be 1 or 0.",
  1698.          l->number );
  1699.       bwb_error( bwb_ebuf );
  1700.       #else
  1701.       bwb_error( err_valoorange );
  1702.       #endif
  1703.       l->next->position = 0;
  1704.       return l->next;
  1705.       }
  1706.  
  1707.    /* Set the new value. */
  1708.  
  1709.    dim_base = newval;
  1710.  
  1711.    /* run through the variable list and change any positions that had
  1712.       set 0 before OPTION BASE was run */ 
  1713.  
  1714.    for ( current = var_start.next; current != &var_end; current = current->next )
  1715.       {
  1716.       current->array_pos[ 0 ] = dim_base;
  1717.       }
  1718.  
  1719.    /* Return. */
  1720.  
  1721.    l->next->position = 0;
  1722.    return l->next;
  1723.  
  1724.    }
  1725.  
  1726. /***************************************************************
  1727.  
  1728.         FUNCTION:       var_findival()
  1729.  
  1730.         DESCRIPTION:    This function returns the address of
  1731.                         the integer for the variable <v>.  If
  1732.                         <v> is a dimensioned array, the address
  1733.                         returned is for the integer at the
  1734.                         position indicated by the integer array
  1735.                         <pp>.
  1736.  
  1737. ***************************************************************/
  1738.  
  1739. int *
  1740. var_findival( struct bwb_variable *v, int *pp )
  1741.    {
  1742.    register int n;
  1743.    size_t offset;
  1744.    int *p;
  1745.  
  1746.    /* Check for appropriate type */
  1747.  
  1748.    if ( v->type != INTEGER )
  1749.       {
  1750.       #if PROG_ERRORS
  1751.       sprintf ( bwb_ebuf, "in var_findival(): variable <%s> is not an integer.", v->name );
  1752.       bwb_error( bwb_ebuf );
  1753.       #else
  1754.       bwb_error( err_mismatch );
  1755.       #endif
  1756.       return NULL;
  1757.       }
  1758.  
  1759.    /* check subscripts */
  1760.  
  1761.    if ( dim_check( v, pp ) == FALSE )
  1762.       {
  1763.       return NULL;
  1764.       }
  1765.  
  1766.    /* Calculate and return the address of the dimensioned array */
  1767.  
  1768.    offset = dim_unit( v, pp );
  1769.  
  1770.    #if INTENSIVE_DEBUG
  1771.    for ( n = 0; n < v->dimensions; ++n )
  1772.       {
  1773.       sprintf( bwb_ebuf,
  1774.          "in var_findival(): dimensioned variable pos <%d> <%d>.",
  1775.          n, pp[ n ] );
  1776.       bwb_debug( bwb_ebuf );
  1777.       }
  1778.    #endif
  1779.  
  1780.    p = (int *) v->array;
  1781.    return (p + offset);
  1782.  
  1783.    }
  1784.  
  1785. /***************************************************************
  1786.  
  1787.         FUNCTION:       var_finddval()
  1788.  
  1789.         DESCRIPTION:    This function returns the address of
  1790.                         the double for the variable <v>.  If
  1791.                         <v> is a dimensioned array, the address
  1792.                         returned is for the double at the
  1793.                         position indicated by the integer array
  1794.                         <pp>.
  1795.  
  1796. ***************************************************************/
  1797.  
  1798. double *
  1799. var_finddval( struct bwb_variable *v, int *pp )
  1800.    {
  1801.    register int n;
  1802.    size_t offset;
  1803.    double *p;
  1804.  
  1805.    /* Check for appropriate type */
  1806.  
  1807.    if ( v->type != DOUBLE )
  1808.       {
  1809.       #if PROG_ERRORS
  1810.       sprintf ( bwb_ebuf, "in var_finddval(): Variable <%s> is not double precision.", 
  1811.          v->name );
  1812.       bwb_error( bwb_ebuf );
  1813.       #else
  1814.       bwb_error( err_mismatch );
  1815.       #endif
  1816.       return NULL;
  1817.       }
  1818.  
  1819.    /* Check subscripts */
  1820.  
  1821.    if ( dim_check( v, pp ) == FALSE )
  1822.       {
  1823.       return NULL;
  1824.       }
  1825.  
  1826.    /* Calculate and return the address of the dimensioned array */
  1827.  
  1828.    offset = dim_unit( v, pp );
  1829.  
  1830.    #if INTENSIVE_DEBUG
  1831.    for ( n = 0; n < v->dimensions; ++n )
  1832.       {
  1833.       sprintf( bwb_ebuf,
  1834.          "in var_finddval(): dimensioned variable pos <%d> <%d>.",
  1835.          n, pp[ n ] );
  1836.       bwb_debug( bwb_ebuf );
  1837.       }
  1838.    #endif
  1839.  
  1840.    p = (double *) v->array;
  1841.    return (p + offset);
  1842.  
  1843.    }
  1844.  
  1845. /***************************************************************
  1846.  
  1847.         FUNCTION:       var_findfval()
  1848.  
  1849.         DESCRIPTION:    This function returns the address of
  1850.                         the float value for the variable <v>.  If
  1851.                         <v> is a dimensioned array, the address
  1852.                         returned is for the float at the
  1853.                         position indicated by the integer array
  1854.                         <pp>.
  1855.  
  1856. ***************************************************************/
  1857.  
  1858. float *
  1859. var_findfval( struct bwb_variable *v, int *pp )
  1860.    {
  1861.    register int n;
  1862.    size_t offset;
  1863.    float *r;
  1864.    float *p;
  1865.  
  1866.    #if INTENSIVE_DEBUG
  1867.    sprintf( bwb_ebuf, "in var_findfval(): variable <%s>, type <%c>",
  1868.       v->name, v->type );
  1869.    bwb_debug( bwb_ebuf );
  1870.    #endif
  1871.  
  1872.    /* Check for appropriate type */
  1873.  
  1874.    if ( v->type != SINGLE )
  1875.       {
  1876.       #if PROG_ERRORS
  1877.       sprintf ( bwb_ebuf, "in var_findfval(): Variable <%s> is not single precision: prec <%c>",
  1878.          v->name, v->type );
  1879.       bwb_error( bwb_ebuf );
  1880.       #else
  1881.       bwb_error( err_mismatch );
  1882.       #endif
  1883.       return NULL;
  1884.       }
  1885.  
  1886.    /* Check subscripts */
  1887.  
  1888.    if ( dim_check( v, pp ) == FALSE )
  1889.       {
  1890.       return NULL;
  1891.       }
  1892.  
  1893.    /* Calculate and return the address of the dimensioned array */
  1894.  
  1895.    offset = dim_unit( v, pp );
  1896.  
  1897.    #if INTENSIVE_DEBUG
  1898.    for ( n = 0; n < v->dimensions; ++n )
  1899.       {
  1900.       sprintf( bwb_ebuf,
  1901.          "in var_findfval(): dimensioned variable <%s> dim <%d> val <%d>.",
  1902.          v->name, n, pp[ n ] );
  1903.       bwb_debug( bwb_ebuf );
  1904.       }
  1905.    #endif
  1906.  
  1907.    #if INTENSIVE_DEBUG
  1908.    sprintf( bwb_ebuf,
  1909.       "in var_findfval(): dimensioned variable <%s> offset <%ld>",
  1910.       v->name, (long) offset );
  1911.       bwb_debug( bwb_ebuf );
  1912.    #endif
  1913.  
  1914.    p = (float *) v->array;
  1915.    r = (p + offset);
  1916.  
  1917.    #if INTENSIVE_DEBUG
  1918.    if ( ( r < (float *) v->array ) || ( r > (float *) v->array_max ))
  1919.       {
  1920.       #if PROG_ERRORS
  1921.       sprintf( bwb_ebuf, "in var_findfval(): return value is out of range" );
  1922.       bwb_error( bwb_ebuf );
  1923.       #else
  1924.       bwb_error( err_valoorange );
  1925.       #endif
  1926.       return r;
  1927.       }
  1928.    #endif
  1929.  
  1930.    return r;
  1931.  
  1932.    }
  1933.  
  1934. /***************************************************************
  1935.  
  1936.         FUNCTION:       var_findsval()
  1937.  
  1938.         DESCRIPTION:    This function returns the address of
  1939.                         the string for the variable <v>.  If
  1940.                         <v> is a dimensioned array, the address
  1941.                         returned is for the string at the
  1942.                         position indicated by the integer array
  1943.                         <pp>.
  1944.  
  1945. ***************************************************************/
  1946.  
  1947. bstring *
  1948. var_findsval( struct bwb_variable *v, int *pp )
  1949.    {
  1950.    register int n;
  1951.    size_t offset;
  1952.    bstring *p;
  1953.  
  1954.    #if INTENSIVE_DEBUG
  1955.    sprintf( bwb_ebuf, "in var_findsval(): entered, var <%s>", v->name );
  1956.    bwb_debug( bwb_ebuf );
  1957.    #endif
  1958.  
  1959.    /* Check for appropriate type */
  1960.  
  1961.    if ( v->type != STRING )
  1962.       {
  1963.       #if PROG_ERRORS
  1964.       sprintf ( bwb_ebuf, "in var_findsval(): Variable <%s> is not a string.", v->name );
  1965.       bwb_error( bwb_ebuf );
  1966.       #else
  1967.       bwb_error( err_mismatch );
  1968.       #endif
  1969.       return NULL;
  1970.       }
  1971.  
  1972.    /* Check subscripts */
  1973.  
  1974.    if ( dim_check( v, pp ) == FALSE )
  1975.       {
  1976.       return NULL;
  1977.       }
  1978.  
  1979.    /* Calculate and return the address of the dimensioned array */
  1980.  
  1981.    offset = dim_unit( v, pp );
  1982.  
  1983.    #if INTENSIVE_DEBUG
  1984.    for ( n = 0; n < v->dimensions; ++n )
  1985.       {
  1986.       sprintf( bwb_ebuf,
  1987.          "in var_findsval(): dimensioned variable pos <%d> val <%d>.",
  1988.          n, pp[ n ] );
  1989.       bwb_debug( bwb_ebuf );
  1990.       }
  1991.    #endif
  1992.  
  1993.    p = (bstring *) v->array;
  1994.    return (p + offset);
  1995.  
  1996.    }
  1997.  
  1998. /***************************************************************
  1999.  
  2000.         FUNCTION:       dim_check()
  2001.  
  2002.         DESCRIPTION:    This function checks subscripts of a
  2003.                         specific variable to be sure that they
  2004.                         are within the correct range.
  2005.  
  2006. ***************************************************************/
  2007.  
  2008. int
  2009. dim_check( struct bwb_variable *v, int *pp )
  2010.    {
  2011.    register int n;
  2012.  
  2013.    /* Check for dimensions */
  2014.  
  2015.    if ( v->dimensions < 1 )
  2016.       {
  2017.       #if PROG_ERRORS
  2018.       sprintf( bwb_ebuf, "in dim_check(): var <%s> dimensions <%d>",
  2019.          v->name, v->dimensions );
  2020.       bwb_error( bwb_ebuf );
  2021.       #else
  2022.       bwb_error( err_valoorange );
  2023.       #endif
  2024.       return FALSE;
  2025.       }
  2026.  
  2027.    /* Check for validly allocated array */
  2028.  
  2029.    if ( v->array == NULL )
  2030.       {
  2031.       #if PROG_ERRORS
  2032.       sprintf( bwb_ebuf, "in dim_check(): var <%s> array not allocated",
  2033.          v->name );
  2034.       bwb_error( bwb_ebuf );
  2035.       #else
  2036.       bwb_error( err_valoorange );
  2037.       #endif
  2038.       return FALSE;
  2039.       }
  2040.  
  2041.    /* Now check subscript values */
  2042.  
  2043.    for ( n = 0; n < v->dimensions; ++n )
  2044.       {
  2045.       if ( ( pp[ n ] < dim_base ) || ( ( pp[ n ] - dim_base )
  2046.          > v->array_sizes[ n ] ))
  2047.          {
  2048.          #if PROG_ERRORS
  2049.          sprintf( bwb_ebuf, "in dim_check(): array subscript var <%s> pos <%d> val <%d> out of range <%d>-<%d>.",
  2050.             v->name, n, pp[ n ], dim_base, v->array_sizes[ n ]  );
  2051.          bwb_error( bwb_ebuf );
  2052.          #else
  2053.          bwb_error( err_valoorange );
  2054.          #endif
  2055.          return FALSE;
  2056.          }
  2057.       }
  2058.  
  2059.    /* No problems found */
  2060.  
  2061.    return TRUE;
  2062.  
  2063.    }
  2064.  
  2065. /***************************************************************
  2066.  
  2067.         FUNCTION:       var_make()
  2068.  
  2069.         DESCRIPTION:    This function initializes a variable,
  2070.                 allocating necessary memory for it.
  2071.  
  2072. ***************************************************************/
  2073.  
  2074. int
  2075. var_make( struct bwb_variable *v, int type )
  2076.    {
  2077.    size_t data_size;
  2078.    bstring *b;
  2079.    #if TEST_BSTRING
  2080.    static int tnumber = 0;
  2081.    #endif
  2082.  
  2083.    switch( type )
  2084.       {
  2085.       case DOUBLE:
  2086.          v->type = DOUBLE;
  2087.          data_size = sizeof( double );
  2088.          break;
  2089.       case INTEGER:
  2090.          v->type = INTEGER;
  2091.          data_size = sizeof( int );
  2092.          break;
  2093.       case STRING:
  2094.          v->type = STRING;
  2095.          data_size = sizeof( bstring );
  2096.          break;
  2097.       default:
  2098.          v->type = SINGLE;
  2099.          data_size = sizeof( float );
  2100.          break;
  2101.       }
  2102.  
  2103.    /* get memory for array */
  2104.  
  2105.    if ( ( v->array = (char *) calloc( 2, data_size )) == NULL )
  2106.       {
  2107.       bwb_error( err_getmem );
  2108.       return NULL;
  2109.       }
  2110.  
  2111.    /* get memory for array_sizes and array_pos */
  2112.  
  2113.    if ( ( v->array_sizes = (int *) calloc( 2, sizeof( int ) )) == NULL )
  2114.       {
  2115.       bwb_error( err_getmem );
  2116.       return NULL;
  2117.       }
  2118.  
  2119.    if ( ( v->array_pos = (int *) calloc( 2, sizeof( int ) )) == NULL )
  2120.       {
  2121.       bwb_error( err_getmem );
  2122.       return NULL;
  2123.       }
  2124.  
  2125.    v->array_pos[ 0 ] = dim_base;
  2126.    v->array_sizes[ 0 ] = 1;
  2127.    v->dimensions = 1;
  2128.    v->common = FALSE;
  2129.    v->array_units = 1;
  2130.  
  2131.    if ( type == STRING )
  2132.       {
  2133.       b = var_findsval( v, v->array_pos );
  2134.       b->rab = FALSE;      
  2135.       }
  2136.  
  2137.    #if INTENSIVE_DEBUG
  2138.    sprintf( bwb_ebuf, "in var_make(): made variable <%s> type <%c> pos[ 0 ] <%d>",
  2139.       v->name, v->type, v->array_pos[ 0 ] );
  2140.    bwb_debug( bwb_ebuf );
  2141.    #endif
  2142.  
  2143.    #if TEST_BSTRING
  2144.    if ( type == STRING )
  2145.       {
  2146.       b = var_findsval( v, v->array_pos );
  2147.       sprintf( b->name, "bstring # %d", tnumber );
  2148.       ++tnumber;
  2149.       sprintf( bwb_ebuf, "in var_make(): new string variable <%s>",
  2150.          b->name );
  2151.       bwb_debug( bwb_ebuf );
  2152.       }
  2153.    #endif
  2154.  
  2155.    return TRUE;
  2156.  
  2157.    }
  2158.  
  2159. /***************************************************************
  2160.  
  2161.         FUNCTION:       bwb_vars()
  2162.  
  2163.         DESCRIPTION:    This function implements the Bywater-
  2164.                 specific debugging command VARS, which
  2165.                 gives a list of all variables defined
  2166.                 in memory.
  2167.  
  2168. ***************************************************************/
  2169.  
  2170. #if PERMANENT_DEBUG
  2171. struct bwb_line *
  2172. bwb_vars( struct bwb_line *l )
  2173.    {
  2174.    struct bwb_variable *v;
  2175.    char tbuf[ MAXSTRINGSIZE + 1 ];
  2176.  
  2177.    /* run through the variable list and print variables */
  2178.  
  2179.    for ( v = var_start.next; v != &var_end; v = v->next )
  2180.       {
  2181.       fprintf( stdout, "variable <%s>\t", v->name );
  2182.       switch( v->type )
  2183.          {
  2184.          case STRING:
  2185.             str_btoc( tbuf, var_getsval( v ) );
  2186.             fprintf( stdout, "STRING\tval: <%s>\n", tbuf );
  2187.             break;
  2188.          case INTEGER:
  2189.             fprintf( stdout, "INTEGER\tval: <%d>\n", var_getival( v ) );
  2190.             break;
  2191.          case DOUBLE:
  2192.             fprintf( stdout, "DOUBLE\tval: <%lf>\n", var_getdval( v ) );
  2193.             break;
  2194.          case SINGLE:
  2195.             fprintf( stdout, "SINGLE\tval: <%f>\n", var_getfval( v ) );
  2196.             break;
  2197.          default:
  2198.             fprintf( stdout, "ERROR: type is <%c>", (char) v->type );
  2199.             break;
  2200.          }
  2201.       }
  2202.  
  2203.    l->next->position = 0;
  2204.    return l->next;
  2205.    }
  2206. #endif
  2207.